home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
SPACE 1
/
SPACE - Library 1 - Volume 1.iso
/
program
/
16
/
blockio.fth
< prev
next >
Wrap
Text File
|
1985-11-19
|
2KB
|
55 lines
\ The low level I/O used to implement standard Forth BLOCKs
decimal
variable disk-error
vocabulary sys sys definitions
20 constant max#files
64 constant /filename
create filenames max#files /filename * allot
filenames max#files /filename * erase
\ Seek to the correct starting address and prepare the arguments
\ to the gem read or write call
: seek ( position file -- )
swap 0 -rot f_lseek drop \ 0 means seek from beginning of file
;
: gem-setio ( address file block -- address b/buf file )
b/buf * over seek ( address file )
b/buf swap
;
: ?disk-abort ( #transferred -- )
b/buf <> dup disk-error !
if ." disk-error " cr abort then
;
: gem-read ( address file block -- )
gem-setio f_read ( #read ) ?disk-abort
;
: gem-write ( address file block -- )
gem-setio f_write ( #read ) ?disk-abort
;
: file-io
['] gem-read is read-block
['] gem-write is write-block
;
: open-file ( str -- file )
2 ( read/write ) over f_open ( str fd )
dup 0<
if ." Can't open " swap count type
else tuck ( fd str fd ) /filename * filenames + "copy
then
;
: file-size ( file -- l ) \ Seek to end of file to find size
2 swap 0 rot f_lseek
;
: file#blocks ( file -- n )
file-size b/buf um/mod nip
;
forth definitions
: .file ( file -- )
[ sys ] /filename * filenames + count type
;
flags !
>buffers dup /b